perm filename RESPC.F4[NEW,LCS]1 blob sn#274265 filedate 1977-04-02 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300		1 /IPG/IPG,JPG,BRACK(-3/4),RSTNUM(8),RPSZ(8),RHGT(8),
00400		1 RCLEF(-3/4) /IVV/IV(1)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100)
01200		INTEGER DUMMY
01300		COMMON /PX/PN(1) /Q/Q(1)
01400		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500		1 /KBAR/KBAR(515) /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
01600		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/
01800	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400		1,(DUMMY,RN(1400))
02500	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
02600	
02700		IF(NMPG.NE.'PAGEA')GO TO 2000
02800		NPZ='PAGEZ'
02900		RNEXT=0
03000	2000	SPCNT=1.0
03100		JX=0
03200		JCEN=0
03300	C  FLAG FOR CENTERED RESTS.
03400		XT=0
03500		PX=0
03600		CALL SHFT1(KQ)
03700		KK=L
03800	CC	TYPE 3001,L
03900	C  DELETES EXTRA BAR LINES, ETC.
04000		IF(IPG)CALL RESTS
04100	C???	IF(N)RETURN 
04200	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04300	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04400		CALL SHIFT
04500	C  L=NUMBER OF ITEMS FOR RHY RECONS.
04600		JJ2=L+2
04700	C FOR WDCNT IN .PAG FILE
04800		N=0
04900		S=-100
05000		R=0
05100		KCLEF=0
05200	
05300		DO 601 K=1,L
05400		R=CODEN(KPN,K,Q,J)
05500		RZ=Q(J)
05600	CX	J=KPN(K)
05700	CC	N=N+1
05800	CC	NN(N)=0
05900	CC	MM(N)=J+3
06000		CALL MMNN(3)
06100	CX	R=Q(J+1)
06200	801	IF(R.NE.1)GO TO 2801
06300		IF(RZ.LT.7)GO TO 601
06400		IF(Q(J+9).LT..05)GO TO 601
06500	CC	IF(Q(J+8).EQ.1000)GO TO 601
06600	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
06700		GO TO 702
06800	2801	IF(R.NE.2)GO TO 1801
06900		IF(RZ.LT.5)GO TO 601
07000		IF(IPG)GO TO 1801
07200		IF(RZ.GE.6)JCEN=-1 
07300	CC	IF(RZ.GE.6)GO TO 601
07400	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
07500	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
07600	1801	IF(R.LT.4)GO TO 702
07700		IF(R.EQ.17)GO TO 1702
07800		IF(R.EQ.18)GO TO 1702
07900		IF(R.LE.7)GO TO 30
08000		IF(R.NE.44)GO TO 601
08100		IF(RZ.EQ.2)GO TO 601
08200	C RZ=2= BAR LINE ON UPPER STAFF
08300		IF(Q(J+6).EQ.0)GO TO 601
08400		IF(Q(J+5).EQ.0)GO TO 601
08500	C  GETS LEFT END OF LINES, CRESC., DASHES.
08600		GO TO 604
08700	30	IF(R.NE.7)GO TO 605
08800		IF(RZ.LT.5)GO TO 604
08900	C JUMP FOR STANDARD TRILL
09000		RS=Q(J+7)
09100		IF(RS.EQ.1)GO TO 604
09200		IF(ABS(RS).GE.3)GO TO 604
09300	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
09400		GO TO 601
09500	605	IF(R.NE.4)GO TO 604
09600		IF(RZ.LE.3)GO TO 702
09700	C JUMP IF IT IS A BAR LINE
09800	CC	IF(RZ.LT.4)GO TO 601
09900		IF(Q(J+6).NE.0)GO TO 604
10000	C GO GET OTHER POS OF LINE
10100		GO TO 601
10200	1702	IF(Q(J+4).NE.0)GO TO 601
10300		IF(Q(J+2).NE.0)GO TO 601
10400	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
10500	702	NN(N)=R 
10600		GO TO 601
10700	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
10800	604	CALL MMNN(6)
10900	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
11000		IF(R.NE.6)GO TO 601
11100	C NEXT FOR BEAMS
11200		IF(RZ.LT.8)GO TO 608
11300		IF(Q(J+10).EQ.0)GO TO 608
11400		IF(Q(J+7).GT.0)CALL MMNN(8)
11500	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
11600	608	IF(RZ.LT.7)GO TO 601
11700		IF(Q(J+7))GO TO 688
11800	C  P7 IS NEG FOR TREMOLO
11900		IF(Q(J+8).EQ.0)GO TO 601
12000	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
12100	688	IF(Q(J+9).GT.0)CALL MMNN(9)
12200	C FOUND A POS. IN P9
12300	601	CONTINUE
12400	
12500	C NEXT SORTS THE POINTS
12600	6000	J=1
12700	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
12800		CALL EXCHG(MM(J),NN(J))
12900	C  ABOVE EXCHGS --(J) AND --(J+1)
13000		IF(J.EQ.1)GO TO 710
13100		J=J-1
13200		GO TO 610
13300	710	J=J+1
13400		IF(J.LT.N)GO TO 610
13500	C NOW ALL SORTED
13600		CALL FNDEND(R)
13700		CALL SHFTQ(R)
13800	C  SHIFTS TO PROPER HORIZ. POS.
13900		IF(IPG)CALL RESTP
14000	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
14100		IF(N.LE.0)GO TO 122
14200	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
14300	
14400		DO 119 K=1,150
14500	119	HH(K)=0
14600	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
14700		G(1)=0
14800		E(1)=0
14900		F(1)=0
15000		RN(1500)=0
15100		RN(2500)=0
15200		ST=0
15300	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
15400	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
15500		KE=0
15600		J=1000
15700	933	JJ=1500
15800		JJJ=2000
15900		T=0
16000		M=0
16100		A=0
16200		B=0
16300	
16400		DO 33 K=1,N
16500		IF(NORH(KK))GO TO 33
16600	CC	KK=NN(K)
16700	CC	IF(KK.EQ.0)GO TO 33
16800	CC	IF(KK.EQ.4)GO TO 2133
16900	CC	IF(KK.EQ.17)GO TO 2133
17000	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
17100	CC	IF(KK.EQ.18)GO TO 2133
17200	CC	IF(KK.GT.2)GO TO 33
17300	2133	LL=MM(K)-3
17400		IF(KK.LE.2)GO TO 1133
17500		RH=.01
17600	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
17700	CCC	IF(KK.NE.4)RH=.6
17800		GO TO 3133
17900	1133	IF(Q(LL+2).NE.ST)GO TO 33
18000	C JUMP IF NOT ON RIGHT STAFF
18100		RA=9
18200		IF(KK.EQ.2)RA=7
18300		IF(Q(LL).LT.RA-2)GO TO 33
18400	C JUMP IF WDCNT IS TOO SHORT
18500		RH=Q(LL+IFIX(RA))
18600		IF(RH.EQ.0)GO TO 33
18700	3133	RZ=Q(LL+3)
18800		IF(ZERO(RZ,A).EQ.0)GO TO 133
18900	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
19000		RRH=RH
19100	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
19200		TT=T
19300	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
19400		J=J+1
19500	C UPDATE COUNTER IN POSITION ARRAY
19600		T=T+RH
19700	C ADD TO TOTAL RHYTHM
19800		RN(J)=T
19900		A=Q(LL+3)
20000	C SAVE POS. OF THIS NOTE.
20100		GO TO 33
20200	133	IF(RH.EQ.RHH)GO TO 33
20300	C  IGNORE 2ND RHYTH IF SAME AS FIRST
20400		IF(ZERO(RZ,B).EQ.0)GO TO 333
20500	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
20600		TTT=TT
20700	C SAVE TOTAL RHYTHM TO THIS POINT.
20800		TT=TT+RH
20900		JJ=JJ+1
21000	C UPDATE COUNTER FOR 2ND ARRAY
21100		RN(JJ)=TT
21200		RRRH=RH
21300		B=A
21400		GO TO 33
21500	333	IF(RH.EQ.RRRH)GO TO 33
21600		TTT=TTT+RH
21700		JJJ=JJJ+1
21800		RN(JJJ)=TTT
21900	33	CONTINUE
22000	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
22100		IF(ST.NE.0)GO TO 733
22200		KE=J-999
22300	C TOTAL NUM OF RHYTHMS ON STAFF1.
22400	CC	IF(JPG.EQ.0)GO TO 2233
22450		IF(JPG.LE.1)GO TO 2233
22475	C JPG=0=PARTS;    =1=PAGE, 1 STAFF
22500	C  JUMP IF ONLY ONE STAFF
22600	733	KF=J-2499
22700	C KF=NUM OF RHYTHMS ON NEXT STAFF.
22800		ST=ST+1
22900		IF(ST.GT.1)GO TO 833
23000	C JUMP IF ALL STAVES HAVE BEEN READ.
23100	1233	J=2500
23200		GO TO 933
23300	833	IF(J.NE.2500)GO TO 1533
23400	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
23500	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
23600	
23700	2233	CALL RLOOP(HH,E,KE)
23800	C FOR SINGLE STAFF OF RHYTHM
23900		KL=KE
24000		GO TO 1333
24100	1533	K=1
24200		L=1
24300		M=0
24400	19	KK=K
24500		LL=L
24600	1	SM=10000
24700		K=K+1
24800		IF(K.GT.KE)GO TO 10
24900	4	L=L+1
25000		Y=F(L)
25100		B=Y-F(L-1)
25200		IF(B.LT.SM)SM=B
25300	2	X=E(K)
25400		A=X-E(K-1)
25500	C  A AND B HAVE TRUE DURATIONS NOW
25600		IF(A.LT.SM)SM=A
25700	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
25800		IF(ZERO(X,Y).EQ.0)GO TO 3
25900	C JUMP IF EQUAL RHYTHS
26000		IF(X.GT.Y)GO TO 4
26100		K=K+1
26200	C STEP FORWARD UNTIL X IS .GT. Y
26300		GO TO 2
26400	3	IF(K.NE.KK+1)GO TO 13
26500		IF(L.NE.LL+1)GO TO 14
26600		M=M+1
26700		G(M)=E(KK)
26800		GO TO 19
26900	13	IF(L.NE.LL+1)GO TO 15
27000		DO 16 J=KK,K-1
27100		M=M+1
27200	16	G(M)=E(J)
27300		GO TO 19
27400	14	DO 17 J=LL,L-1
27500		M=M+1
27600	17	G(M)=F(J)
27700		GO TO 19
27800	15	XM=SM-.001
27900		M=M+1
28000		P=E(KK)
28100		G(M)=P
28200	7	KK=KK+1
28300		LL=LL+1
28400		YM=SM*1.5
28500	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
28600		S=P
28700		T=P
28800	27	A=E(KK)
28900		B=F(LL)
29000		IF(ZERO(A,B).EQ.0)GO TO 19
29100		X=ZERO(A,P)
29200		Y=ZERO(B,P)
29300	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
29400		S=E(KK-1)
29500		T=F(LL-1)
29600	9	IF(A-S.LT.X-.01)X=ZERO(A,S)
29700		IF(B-T.LT.Y-.01)Y=ZERO(B,T)
29800		IF(A.GT.B+.01)GO TO 8
29900		B=A
30000		KK=KK+1
30100	62	IF(X.GT.YM)GO TO 5
30200		IF(X.EQ.0)GO TO 27
30300		P=P+SM
30400	25	M=M+1
30500		G(M)=P
30600		GO TO 27
30700	5	P=P+SM
30800		IF(P)GO TO 203
30900	C IF(P)ERROR
31000		IF(P.LT.B-.01)GO TO 5
31100		GO TO 25
31200	8	X=Y
31300		LL=LL+1
31400		GO TO 62
31500	10	M=M+1
31600		G(M)=E(KE)
31700	CC	TYPE 410,(E(K),K=1,KE)
31800	CC	TYPE 410,(F(K),K=1,KF)
31900	CC	TYPE 410,(G(K),K=1,M)
32000	CBCB	WRITE(21,410)(E(K),K=1,KE)
32100	CB	WRITE(21,410)(F(K),K=1,KF)
32200	CB	WRITE(21,410)(G(K),K=1,M)
32300	410	FORMAT(10F7.2)
32400	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
32500	1033	JJ=1
32600		H(1)=0
32700		J=1
32800		K=2
32900		L=2
33000	511	IF(J.EQ.M)GO TO 911
33100		J=J+1
33200		X=G(J)
33300	1211	A=E(K)
33400		B=F(L)
33500		Y=ZERO(X,A)
33600		Z=ZERO(X,B)
33700		IF(A-B.GT..01)GO TO 1111
33800		IF(Y.EQ.0)GO TO 1311
33900		IF(X.LT.A-.01)GO TO 1111
34000		K=K+1
34100	1411	JJ=JJ+1
34200		H(JJ)=-A
34300		GO TO 1211
34400	1111	IF(Z.EQ.0)GO TO 1311
34500		IF(X.LT.B-.01)GO TO 1311
34600		L=L+1
34700		A=B
34800		GO TO 1411
34900	
35000	1311	JJ=JJ+1
35100		H(JJ)=X
35200		IF(Y.EQ.0)GO TO 611
35300		IF(Z.EQ.0)GO TO 711
35400		IF(ZERO(A,B).EQ.0)GO TO 511
35500		P=A
35600		IF(P.GT.B+.01)GO TO 811
35700		IF(P.GT.X+.01)GO TO 511
35800		K=K+1
35900		GO TO 1011
36000	811	P=B
36100		IF(P.GT.X+.01)GO TO 511
36200		L=L+1
36300	1011	JJ=JJ+1
36400		H(JJ)=-P
36500	C NON-SPACED RHYTHS ARE NEG.
36600		GO TO 511
36700	611	K=K+1
36800		IF(Z.GT.0)GO TO 511
36900	711	L=L+1
37000		GO TO 511
37100	911	IF(HH(2).EQ.0)GO TO 2011
37200		K=2
37300		J=2
37400		L=1
37500		HHH(1)=0
37600	1511	IF(J.GT.JJ)GO TO 1811
37700		P=H(J)
37800		A=ABS(P)
37900		B=ABS(HH(K))
38000		IF(ZERO(B,A).EQ.0)GO TO 1611
38100		IF(A.GT.B)GO TO 1711
38200		J=J+1
38300		GO TO 1911
38400	1711	P=HH(K)
38500		GO TO 2211
38600	1611	J=J+1
38700	2211	K=K+1
38800	1911	L=L+1
38900		HHH(L)=P
39000		GO TO 1511
39100	2011	CALL RLOOP(HH,H,JJ)
39200		KL=JJ
39300		GO TO 2111
39400	1811	CALL RLOOP(HH,HHH,L)
39500		KL=L
39600	2111	IF(ST.GE.JPG)GO TO 1333
39700		CALL RLOOP(E,G,M)
39800		KE=M
39900	C GO WAY BACK AND READ ANOTHER LINE.
40000		GO TO 1233
40100	1333	E(1)=0
40200		GO TO 2333
40300		TYPE 410,(HH(K),K=1,KL)
40400		WRITE(21,410)(HH(K),K=1,KL)
40500	2333	JD=1
40600	C JD IS COUNTER FOR DUMMY POSITIONS.
40700		DUMMY(1)=1
40800		ST=0
40900	183	B=0
41000		LL=2
41100	
41200		DO 181 K=1,N
41300		IF(NORH(L))GO TO 181
41400	C LOOK FOR DUMMY RHYTHMS.
41500		IF(L.LE.2)GO TO 2184
41600		RZ=.01
41700	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
41800		GO TO 1184
41900	2184	LF=MM(K)
42000		IF(Q(LF-1).NE.ST)GO TO 181
42100	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
42200		J=6
42300		IF(L.EQ.2)J=4
42400		RZ=Q(LF+J)
42500	1184	B=B+RZ
42600	184	V=ABS(HH(LL))
42700		IF(ZERO(B,V).GT.0)GO TO 182
42800	C FOUND RHYTH MATCH
42900		JD=JD+1
43000		DUMMY(JD)=LL
43100		LL=LL+1
43200		GO TO 181
43300	182	IF(B.LT.V-.01)GO TO 181
43400		LL=LL+1
43500		GO TO 184
43600	181	CONTINUE
43700		ST=ST+1
43800		IF(ST.LT.JPG)GO TO 183
43900	
44000	C NEXT SORT DUMMY ARRAY
44100		J=0
44200	185	DO 186 K=2,JD
44300		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
44400		DO 188 LL=K,JD
44500	188	DUMMY(LL-1)=DUMMY(LL)
44600		JD=JD-1
44700		GO TO 185
44800	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
44900		CALL EXCH(DUMMY(K),DUMMY(K-1))
45000		GO TO 185
45100	186	CONTINUE
45200	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
45300		PX=0
45400		LF=0
45500		K=1
45600		V=0
45700	
45800	81	K=K+1
45900		IF(K.GT.KL)GO TO 1433
46000		B=HH(K)
46100		A=B-V
46200		V=B
46300		IF(V)GO TO 82
46400	85	W=V
46500		IF(A.GT.0.01)GO TO 89
46600	C  .GT. BECAUSE OF ROUND-OFF ERROR
46700		T=5
46800		IF(HH(K+1)-V.LE..01)T=2
46900		PX=PX+T
47000	C THIS FOR BARS, KSIG, METER
47100		GO TO 189
47200	89	PX=PX+PFIB(A)
47300	189	E(K)=PX
47400		IF(LF.NE.0)GO TO 86
47500		GO TO 81
47600	82	LF=K
47700	83	K=K+1
47800		V=HH(K)
47900		IF(V)GO TO 83
48000		A=V-W
48100		GO TO 85
48200	86	LL=LF-1
48300		D=E(K)-E(LL)
48400	87	S=-HH(LF)-HH(LL)
48500		T=HH(K)-HH(LL)
48600		T=S/T
48700	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
48800		E(LF)=E(LL)+D*T
48900		LF=LF+1
49000		IF(LF.NE.K)GO TO 87
49100		LF=0
49200		GO TO 81
49300	
49400	1433	GO TO 2433
49500		TYPE 410,(E(K),K=1,KL)
49600		WRITE(21,410)(E(K),K=1,KL)
49700	C  5 IS SPACE AFTER 1ST BARLINE
49800	2433	R8=RNEXT
49900	C POS OF 1ST BAR = END OF PREV. LINE
50000		IF(ENDLN.EQ.0)RNEXT=9
50100	C  MAKES ROOM FOR 1ST CLEF.
50200		KL=KL-1
50300		J=0
50400		R5=0
50500		KK=1
50600		JD=1
50700		W=0
50800		LF=0
50900	
51000		DO 80 K=1,N
51100		IF(NORH(L))GO TO 80
51200		A=Q(MM(K))
51300		IF(ZERO(A,W).EQ.0)GO TO 80
51400	C  SKIP IF SAME POS OF NOTE OR REST.
51500		W=A
51600		R7=R8
51700	190	J=J+1
51800		IF(J.LE.KL)GO TO 290
51900	203	FORMAT(' FOUND CENTERED WHOLE REST!')
52000		LL=0
52100		IF(JCEN.GE.0)GO TO 120
52200		TYPE 203
52300		GO TO 121
52400	120	W=LL
52500		A=0
52600		DO 124 K=1,N
52700		LF=NN(K)
52800		IF(LF.GT.2)GO TO 124
52900		IF(LF.EQ.0)GO TO 124
53000		KE=MM(K)
53100		IF(Q(KE-1).NE.W)GO TO 124
53200	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
53300		JD=6
53400		IF(LF.EQ.2)JD=4
53500		A=A+Q(KE+JD)
53600	124	CONTINUE
53700		TYPE 123,LL,A
53800		LL=LL+1
53900		IF(LL.LT.JPG)GO TO 120
54000	123	FORMAT(' STF',I2,' =',F7.3,' QTRS')
54100	121	PAUSE' RHYTHM MISMATCH'
54200		GO TO 90
54300	290	IF(DUMMY(JD).NE.J)GO TO 190
54400		JD=JD+1
54500	90 	R8=RNEXT+E(J)
54600		R4=R5
54700		R5=A
54800		X=(R8-R7)/(R5-R4)
54900		S=R7-R4*X
55000		DO 91 L=KK,K
55100		LL=MM(L)
55200	91	Q(LL)=S+X*Q(LL)
55300		KK=K+1
55400	80	CONTINUE
55500	
55600		IF(KK.GT.K)GO TO 180
55700	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
55800		R7=Q(LL)-R5
55900	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
56000		DO 280 L=KK,K
56100		LL=MM(L)
56200	280	Q(LL)=R7+Q(LL)
56300	180	LCNT=0
56400		NDPY=0
56500	C JJ2 IS END OF PNTR DATA
56600		JPQ=KPN(JJ2-1)+1
56700		CALL PUTEXT(NMPG,'PAG')
56800		CALL EXTOUT(RSTFAC,128)
56900		CALL EXTOUT(PN,JJ2)
57000		CALL EXTOUT(Q,JPQ)
57100		CALL FINEXT
57200	
57300		LASTNM=NMPG
57400		LF=JJ2-2
57500		DO 12 J=1,LF
57600		IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
57700		KBR=KBR+1
57800	C BAR LINE COUNTER
57900		T=Q(LA+3)
58000	C TOTAL SPACE
58100	222	BARS(KBR)=T-RNEXT
58200	C SIZE OF THIS MEASURE
58300		K=J
58400		RNEXT=T
58500	12	CONTINUE
58600		IF(K.NE.LF)RNEXT=Q(KPN(LF)+3)
58700		RNEXT=RNEXT+3
58800	322	NMPG=NMPG+2
58900		IF(NMPG.LE.NPZ)GO TO 122
59000	C  WILL GO FROM PAGEA TO PAGFZ  (52)   ADD TO THIS!!
59100		NMPG='PAGFA'
59200		NPZ=NPZ+256
59300	CZ122	KNM(1)=KNM(1)+2
59400	122	ENDLN=RNEXT
59500		END